﻿#VisualFreeBasic_Form#  Version=5.8.3
Locked=0

[Form]
Name=Form1
ClassStyle=CS_VREDRAW,CS_HREDRAW,CS_DBLCLKS
ClassName=
WinStyle=WS_VISIBLE,WS_EX_CONTROLPARENT,WS_EX_LEFT,WS_EX_LTRREADING,WS_EX_RIGHTSCROLLBAR,WS_BORDER,WS_CAPTION,WS_SYSMENU,WS_CLIPSIBLINGS,WS_CLIPCHILDREN,WS_POPUP
Style=3 - 常规窗口
Icon=tianjia.ico
Caption=新建工程
StartPosition=2 - 父窗口中心
WindowState=0 - 正常
Enabled=True
Repeat=False
Left=0
Top=0
Width=536
Height=359
TopMost=False
Child=False
MdiChild=False
TitleBar=True
SizeBox=False
SysMenu=True
MaximizeBox=False
MinimizeBox=False
Help=False
Hscroll=False
Vscroll=False
MinWidth=0
MinHeight=0
MaxWidth=0
MaxHeight=0
NoActivate=False
MousePass=False
TransPer=0
TransColor=SYS,25
Shadow=0 - 无阴影
BackColor=SYS,15
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False
AcceptFiles=False

[YFTreeView]
Name=YFTreeView1
Index=-1
Style=1 - 细边框
Enabled=True
Visible=True
ForeColor=&H000000
BackColor=&HFFFFFF
MoveColor=&HFFE5CC
SelFore=&HFFFFFF
SelBack=&HE57300
ScrollFore=&H878787
ScrollBack=&HE1E1E1
ScrollMove=&H4B4B4B
LinesColor=&HA5A5A5
ItemHeight=20
Indent=10
HasLines=True
Check=False
GridLines=False
FocusLine=False
NoHScroll=False
Left=11
Top=110
Width=510
Height=153
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False
AcceptFiles=False

[TextBox]
Name=Text1
Index=-1
Style=3 - 凹边框
TextScrollBars=0 - 无滚动条
Text=
Enabled=True
Visible=True
MaxLength=0
ForeColor=SYS,8
BackColor=SYS,5
Font=微软雅黑,9,0
TextAlign=0 - 左对齐
PasswordChar=
Locked=False
HideSelection=True
Multiline=False
Uppercase=False
Lowercase=False
Number=False
AutoHScroll=True
AutoVScroll=False
Left=52
Top=269
Width=384
Height=25
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False
LeftMargin=0
RightMargin=0
AcceptFiles=False

[Button]
Name=Command1
Index=-1
Caption=确定
TextAlign=1 - 居中
Ico=
Enabled=True
Visible=True
Default=False
OwnDraw=False
MultiLine=False
Font=微软雅黑,9,0
Left=465
Top=266
Width=56
Height=29
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False

[Label]
Name=Label1
Index=0
Style=0 - 无边框
Caption=名称：
Enabled=True
Visible=True
ForeColor=SYS,8
BackColor=SYS,25
Font=微软雅黑,9,0
TextAlign=0 - 左对齐
Prefix=True
Ellipsis=False
Left=12
Top=273
Width=66
Height=17
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
ToolTip=
ToolTipBalloon=False

[Button]
Name=Command2
Index=-1
Caption=取消
TextAlign=1 - 居中
Ico=
Enabled=True
Visible=True
Default=False
OwnDraw=False
MultiLine=False
Font=微软雅黑,9,0
Left=465
Top=297
Width=56
Height=29
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False

[TextBox]
Name=Text2
Index=-1
Style=3 - 凹边框
TextScrollBars=0 - 无滚动条
Text=
Enabled=True
Visible=True
MaxLength=0
ForeColor=SYS,8
BackColor=SYS,5
Font=微软雅黑,9,0
TextAlign=0 - 左对齐
PasswordChar=
Locked=False
HideSelection=True
Multiline=False
Uppercase=False
Lowercase=False
Number=False
AutoHScroll=True
AutoVScroll=False
Left=51
Top=299
Width=385
Height=25
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False
LeftMargin=0
RightMargin=0
AcceptFiles=False

[Label]
Name=Label2
Index=0
Style=0 - 无边框
Caption=位置：
Enabled=True
Visible=True
ForeColor=SYS,8
BackColor=SYS,25
Font=微软雅黑,9,0
TextAlign=0 - 左对齐
Prefix=True
Ellipsis=False
Left=11
Top=302
Width=66
Height=17
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
ToolTip=
ToolTipBalloon=False

[Button]
Name=Command3
Index=-1
Caption=...
TextAlign=1 - 居中
Ico=
Enabled=True
Visible=True
Default=False
OwnDraw=False
MultiLine=False
Font=微软雅黑,9,0
Left=441
Top=298
Width=21
Height=27
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False


[AllCode]
'这是标准的工程模版，你也可做自己的模版。
'写好工程，复制全部文件到VFB软件文件夹里【template】里即可，子文件夹名为 VFB新建工程里显示的名称
'快去打造属于你自己的工程模版吧。
Dim Shared As Long 选择项目, 鼠标在此, 鼠标按下
Dim Shared gcmb() As String
Sub Form1_Shown(hWndForm As hWnd ,UserData As Integer)  '窗口完全显示后。UserData 来自显示窗口最后1个参数。
   
   设置模板(选择项目)
End Sub

Sub Form1_FormPaintEnd(hWndForm As hWnd ,gg As yGDI ,nBackColor As Long) '重绘最后，已经画好虚拟控件，用 gg 来画。
   Dim zym(4) As String = {"PNG_PRO" ,"PNG_BAS" ,"PNG_CONTROL" ,"PNG_PLUGINS","PNG_MY"}
   Dim wz(4)  As String
   Dim i      As Long
   wz(0) = vfb_LangString("VFB工程")
   wz(1) = vfb_LangString("BAS工程")
   wz(2) = vfb_LangString("VFB控件")
   wz(3) = vfb_LangString("VFB插件")
   wz(4) = vfb_LangString("我的代码")
   
   gg.Brush
   For i = 0 To 4
      If 选择项目 = i Then
         gg.GpLoadImgRes(App.HINSTANCE ,"PNG_SEL")
         gg.GpDrawCopyImg i * 100 + 15 ,3 ,100 ,100 ,0 ,0 ,128 ,128
      end if
      gg.GpLoadImgRes(App.hInstance ,zym(i))
      If 鼠标在此 = i + 1 Then
         If 鼠标按下 Then
            gg.GpDrawCopyImg i * 100 + 35 ,15 ,60 ,60 ,0 ,0 ,128 ,128
         Else
            gg.GpDrawCopyImg i * 100 + 25 ,5 ,80 ,80 ,0 ,0 ,128 ,128
         End If
      Else
         gg.GpDrawCopyImg i * 100 + 30 ,10 ,70 ,70 ,0 ,0 ,128 ,128
      end if
      gg.DrawTextS i * 100 + 15 ,80 ,100 ,20 ,wz(i) ,DT_CENTER Or DT_VCENTER Or DT_SINGLELINE
      
   Next
   
   
End Sub

Sub Form1_WM_MouseMove(hWndForm As hWnd ,MouseFlags As Long ,xPos As Long ,yPos As Long)  '移动鼠标
   'MouseFlags  MK_CONTROL   MK_LBUTTON     MK_MBUTTON     MK_RBUTTON    MK_SHIFT     MK_XBUTTON1       MK_XBUTTON2
   ''           CTRL键按下   鼠标左键按下   鼠标中键按下   鼠标右键按下  SHIFT键按下  第一个X按钮按下   第二个X按钮按下
   '检查什么键按下用  If (MouseFlags And MK_CONTROL)<>0 Then CTRL键按下
   Dim aa As Long = 获取鼠标在什么位置(xPos ,yPos)
   Dim bb As Long = MouseFlags = 1
   If bb Then
      
   Else
      If aa <> 鼠标在此 Or 鼠标按下 <> bb Then
         鼠标在此 = aa
         鼠标按下 = bb
         Me.Refresh
      End If
   End If
End Sub
Sub Form1_WM_MouseLeave(hWndForm As hWnd)  '鼠标离开窗口
   '注意：是指鼠标离开窗口的用户区，比如鼠标到非用户区（标题栏、边框等）以及移动到窗口内的控件，都会触发此事件。
   '简单的说，鼠标不被用户区窗口捕获时，就触发事件。
   If 鼠标在此 <> 0 Or 鼠标按下 <> 0 Then
      鼠标在此 = 0
      鼠标按下 = 0
      Me.Refresh
   End If
End Sub
Sub Form1_WM_LButtonDown(hWndForm As hWnd, MouseFlags As Long, xPos As Long, yPos As Long)  '按下鼠标左键
   'MouseFlags  MK_CONTROL   MK_LBUTTON     MK_MBUTTON     MK_RBUTTON    MK_SHIFT     MK_XBUTTON1       MK_XBUTTON2
   ''           CTRL键按下   鼠标左键按下   鼠标中键按下   鼠标右键按下  SHIFT键按下  第一个X按钮按下   第二个X按钮按下
   '检查什么键按下用  If (MouseFlags And MK_CONTROL)<>0 Then CTRL键按下
   Dim aa As Long = 获取鼠标在什么位置(xPos, yPos)
   Dim bb As Long = True
   If aa <> 鼠标在此 Or 鼠标按下 <> bb Then
      鼠标在此 = aa
      鼠标按下 = bb
      Me.Refresh
      
   End If
End Sub
Sub Form1_WM_LButtonUp(hWndForm As hWnd ,MouseFlags As Long ,xPos As Long ,yPos As Long)  '释放鼠标左键
   'MouseFlags  MK_CONTROL   MK_LBUTTON     MK_MBUTTON     MK_RBUTTON    MK_SHIFT     MK_XBUTTON1       MK_XBUTTON2
   ''           CTRL键按下   鼠标左键按下   鼠标中键按下   鼠标右键按下  SHIFT键按下  第一个X按钮按下   第二个X按钮按下
   '检查什么键按下用  If (MouseFlags And MK_CONTROL)<>0 Then CTRL键按下
   Dim aa As Long = 获取鼠标在什么位置(xPos ,yPos) ,bb As Long
   Dim i  As Long ,p As Long
   If aa = 鼠标在此 And aa > 0 Then
      选择项目 = aa -1
      设置模板(选择项目)
   End If
   
   If aa <> 鼠标在此 Or 鼠标按下 <> bb Then
      鼠标在此 = aa
      鼠标按下 = bb
      Me.Refresh
   End If
End Sub

Function 获取鼠标在什么位置(xPos As Long ,yPos As Long) As Long
   Dim i As Long ,x As Long ,y As Long
   y = 10
   For i = 0 To 4
      x = i * 100 + 30
      If xPos >= AfxScaleX(x) And xPos <= AfxScaleX(x + 70) And yPos >= AfxScaleY(y) And yPos <= AfxScaleY(y + 70) Then Return i + 1
   Next
End Function

Sub 设置模板(aa As Long)
   YFTreeView1.DeleteAllItems
   Dim vfbAPP As APP_TYPE Ptr = GetExeAPP()
   Dim OpApp  As pezi Ptr     = GetOpAPP()
   Dim tt     As String       = Text1.Text
   
   Select Case aa
      Case 0 '"VFB工程"
         Erase gcmb
         Dim lName() As WIN32_FIND_DATAW ,i As Long
         Dim pa      As String = vfbAPP->Path & "template\project\"
         if GetDIR(pa & "*.*" ,lName()) Then
            For i = 0 To UBound(lname)
               If (lname(i).dwFileAttributes And fbDirectory) <> 0 Then
                  Dim zlName() As WIN32_FIND_DATAW ,zi As Long
                  if GetDIR(pa & CWSTRtoString(lname(i).cFileName) & "\*.*" ,zlName()) Then
                     For zi = 0 To UBound(zlname)
                        If (zlname(i).dwFileAttributes And fbDirectory) <> 0 Then
                           Dim pf As String = DirW(pa & CWSTRtoString(lname(i).cFileName) & "\" & CWSTRtoString(zlname(zi).cFileName) & "\*.ffp")
                           if Len(pf) Then
                              Dim uu As Long = UBound(gcmb) + 1
                              ReDim Preserve gcmb(uu)
                              gcmb(uu) = pa & CWSTRtoString(lname(i).cFileName) & "\" & CWSTRtoString(zlname(zi).cFileName) & "\" & pf
                              YFTreeView1.AddItem(0 ,pf ,uu)
                           End if
                        End if
                     Next
                  End if
               End if
            Next
         End if
         If tt = "" Then tt = vfb_LangString("新VFB工程")
         Text2.Text       = PathActualToRelative(OpApp->DefaultProjectPath ,vfbAPP->Path) & tt & "\"
         Text2.Enabled    = True
         Command3.Enabled = True
      Case 1 '"BAS工程"
         Erase gcmb
         Dim lName() As WIN32_FIND_DATAW ,i As Long
         Dim pa      As String = vfbAPP->Path & "template\project\"
         if GetDIR(pa & "*.*" ,lName()) Then
            For i = 0 To UBound(lName)
               If (lname(i).dwFileAttributes And fbDirectory) <> 0 Then
                  Dim zlName() As WIN32_FIND_DATAW ,zi As Long
                  if GetDIR(pa & CWSTRtoString(lname(i).cFileName) & "\*.fbtpl" ,zlName()) Then
                     For zi = 0 To UBound(zlname)
                        If (zlname(i).dwFileAttributes And fbDirectory) = 0 Then
                           Dim cc As String = GetFileStrW(pa & CWSTRtoString(lname(i).cFileName) & "\" & CWSTRtoString(zlname(zi).cFileName))
                           Dim ff As Long   = InStr(17 ,cc ,vbCrLf)
                           If ff > 0 Then
                              cc = Mid(cc ,17 ,ff -17)
                              
                              Dim uu As Long = UBound(gcmb) + 1
                              ReDim Preserve gcmb(uu)
                              gcmb(uu) = pa & CWSTRtoString(lName(i).cFileName) & "\" & CWSTRtoString(zlName(zi).cFileName)
                              YFTreeView1.AddItem(0 ,cc ,uu)
                           End If
                           
                        End if
                     Next
                  End if
               End if
            Next
         End if
         If tt = "" Then tt = vfb_LangString("新BAS工程")
         Text2.Text       = PathActualToRelative(OpApp->DefaultProjectPath ,vfbapp->Path) & tt & "\"
         Text2.Enabled    = True
         Command3.Enabled = True
      Case 2 '"VFB控件"
         Erase gcmb
         Dim lName() As WIN32_FIND_DATAW ,i As Long
         Dim pa      As String = vfbAPP->Path & "template\Control\"
         if GetDIR(pa & "*.*" ,lName()) Then
            For i = 0 To UBound(lname)
               If (lname(i).dwFileAttributes And fbDirectory) <> 0 Then
                  Dim zlName() As WIN32_FIND_DATAW ,zi As Long
                  if GetDIR(pa & CWSTRtoString(lname(i).cFileName) & "\*.*" ,zlName()) Then
                     Dim pf As String = DirW(pa & CWSTRtoString(lname(i).cFileName) & "\Code\*.ffp")
                     if Len(pf) Then
                        Dim uu As Long = UBound(gcmb) + 1
                        ReDim Preserve gcmb(uu)
                        gcmb(uu) = pa & CWSTRtoString(lName(i).cFileName) & "\Code\" & pf
                        YFTreeView1.AddItem(0 ,lName(i).cFileName ,uu)
                     End if
                  End if
               End if
            Next
         End if
         If tt = "" Then tt = vfb_LangString("新控件")
         Text2.Text       = ".\Control\" & tt & "\"
         Text2.Enabled    = False
         Command3.Enabled = False
      Case 3 '"VFB插件"
         Erase gcmb
         Dim lName() As WIN32_FIND_DATAW ,i As Long
         Dim pa      As String = vfbAPP->Path & "template\Plugins\"
         if GetDIR(pa & "*.*" ,lName()) Then
            For i = 0 To UBound(lname)
               If (lname(i).dwFileAttributes And fbDirectory) <> 0 Then
                  Dim zlName() As WIN32_FIND_DATAW ,zi As Long
                  if GetDIR(pa & CWSTRtoString(lname(i).cFileName) & "\*.*" ,zlName()) Then
                     Dim pf As String = DirW(pa & CWSTRtoString(lname(i).cFileName) & "\*.ffp")
                     if Len(pf) Then
                        Dim uu As Long = UBound(gcmb) + 1
                        ReDim Preserve gcmb(uu)
                        gcmb(uu) = pa & CWSTRtoString(lName(i).cFileName) & "\" & pf
                        YFTreeView1.AddItem(0 ,lName(i).cFileName)
                     End if
                  End if
               End if
            Next
         End if
         If tt = "" Then tt = vfb_LangString("新插件")
         Text2.Text       = ".\Plugins\Code\" & tt & "\"
         Text2.Enabled    = False
         Command3.Enabled = False
      Case 4
         Dim 目录 As String
         目录 = INI_GetKey(vfbAPP->Path & "Settings\vfb.ini" ,"Compiler" ,"MyFolder" ,".\Private\")
         目录 = PathRelativeToActual(目录 ,vfbAPP->Path)
         If Right(目录 ,1) <> "\" Then 目录 &= "\"
         ReDim gcmb(0)
         gcmb(0) = 目录
         YFTreeView1.AddItem(0 ,vfb_LangString("根目录（修改、删除等等操作请用资源管理器）") ,0 ,&HE65A)
         加载我的代码库文件夹(0 ,目录)
         YFTreeView1.ExpandAllItems
         If UBound(gcmb) > -1 Then
            Text2.Text = PathActualToRelative(gcmb(0) ,vfbAPP->Path) '新工程\"
         Else
            Text2.Text = ""
         End If
         Text1.Tag        = ""
         Text2.Enabled    = False
         Command3.Enabled = False
   End Select
   If YFTreeView1.GetCount Then YFTreeView1.Selection = YFTreeView1.GetChild(0)
   Text1.Tag = tt
   Text1.SetFocus
End Sub

Sub Form1_Command2_BN_Clicked(hWndForm As hWnd, hWndControl As hWnd)  '单击
  Form1.Close 
End Sub

Sub Form1_Command1_BN_Clicked(hWndForm As hWnd ,hWndControl As hWnd) '单击
   Dim hItem As YFTreeViewData Ptr = YFTreeView1.Selection
   If hItem = 0 Then Return
   Dim aa    As Long   = hItem->DataValue
   Dim pName As String = Text1.Text
   pName = Trim(pName)
   if Len(pName) = 0 Then
      MsgBox(hWndForm ,vfb_LangString("还未输入名称，请输入。") , _
         "VisualFreeBasic" ,MB_OK Or MB_ICONERROR Or MB_DEFBUTTON1 Or MB_APPLMODAL)
      Text1.SetFocus
      Return
   end if
   if InStr(pName ," ") Then
      MsgBox(hWndForm ,vfb_LangString("名称中不允许使用空格，请修改。") , _
         "VisualFreeBasic" ,MB_OK Or MB_ICONERROR Or MB_DEFBUTTON1 Or MB_APPLMODAL)
      Text1.SetFocus
      Return
   end if
   If InStr(pName ,Any "/\:*""<>|?") Then
      MsgBox(hWndForm ,vfb_LangString("名称中不允许使用特殊字符，请修改。") & vbCrLf & vfb_LangString("特殊字符") & "  /\:*""<>|?" , _
         "VisualFreeBasic" ,MB_OK Or MB_ICONERROR Or MB_DEFBUTTON1 Or MB_APPLMODAL)
      Text1.SetFocus
      Return
   end if
   
   
   Dim vfbAPP             As APP_TYPE Ptr = GetExeAPP()
   Dim DefaultProjectPath As String       = Text2.Text '默认工程文件夹
   If Right(DefaultProjectPath ,1) <> "\" Then DefaultProjectPath &= "\"
   Dim pa As String = PathRelativeToActual(DefaultProjectPath ,vfbapp->Path) '把相对路径，转换为实际路径+
   
   Select Case 选择项目
      Case 0 '"VFB工程"
         If NewProValue(pName ,pa ,gcmb(aa) ,pName & ".ffp") Then Return '新建工程
      Case 1 '"BAS工程"
         If NewProValue(pName ,pa ,gcmb(aa) ,pName & ".bas") Then Return '新建工程
      Case 2 '"VFB控件"
         If NewProControl(pName) Then Return '新建工程
         
      Case 3 '"VFB插件"
         pa = vfbAPP->Path & "Plugins\Code\" & pName & "\"
         If NewProValue(pName ,pa ,gcmb(aa) ,pName & ".ffp") Then Return '新建工程
      Case 4
         pa = gcmb(aa) & pName & ".inc"
         If AfxFileExists(pa) Then
            Select Case MsgBox(hWndForm ,vfb_LangString("文件已经存在，你需要打开这个文件吗？") & vbCrLf & pa , _
                     MB_YESNO Or MB_ICONQUESTION Or MB_DEFBUTTON1 Or MB_APPLMODAL)
               Case IDYES
               Case IDNO
                  Return
            End Select
         Else
            SaveFileStr(pa," '修改文件后，在工具菜单中选择【刷新我的代码库】那样你的修改才会生效。")
         End If
          If AfxFileExists(pa)=0 Then
          MsgBox( hWndForm,vfb_LangString("创建文件失败！") & vbCrLf & pa , _
            MB_OK Or MB_ICONERROR Or MB_DEFBUTTON1 Or MB_APPLMODAL)

            Return 
         End If        
         OpenGongCen(pa)
   End Select
   Form1.Close
End Sub

Function NewProValue(pName As String ,pPath As String ,pExe As String ,pFile As String) As Long '新建工程 ,失败返回非0
   'pName 工程名称  pPath 工程目录  pExe 模板文件  pFile 工程文件
   'Print pName
   'Print pPath
   'Print pExe
   'Print pFile
   Dim kk As String
   pPath = PathRelativeToActual(pPath ,App.Path) '把相对路径，转换为实际路径
   If Right(pPath ,1) <> "\" Then pPath &= "\"
   kk = DirW(pPath & "*.*")
   
   If Len(kk) > 0 Then
      MsgBox(Form1.hWnd ,vfb_LangString("工程目录不是个空目录，包含有内容。") & vbCrLf & vfb_LangString("不可以在非空目录里新建工程。") & vbCrLf & _
         pPath ,MB_OK Or MB_ICONERROR Or MB_DEFBUTTON1 Or MB_APPLMODAL)
      Return 1
   End If
   If Len(pPath) < 4 Then
      If Mid(pPath ,2 ,1) = ":" Then
         
         MsgBox(Form1.hWnd ,vfb_LangString("工程目录不可以在根目录。") ,MB_OK Or MB_ICONERROR Or MB_DEFBUTTON1 Or MB_APPLMODAL)
         
      Else
         
         MsgBox(Form1.hWnd ,vfb_LangString("工程目录路径错误！！！") & vbCrLf & vfb_LangString("请检查输入完整的工程目录") ,MB_OK Or MB_ICONERROR Or MB_DEFBUTTON1 Or MB_APPLMODAL)
      End If
      Return 1
   End If
   If Mid(pPath ,2 ,2) <> ":\" Then
      MsgBox(Form1.hWnd ,vfb_LangString("工程目录路径错误！！！") & vbCrLf & vfb_LangString("请检查输入完整的工程目录") ,MB_OK Or MB_ICONERROR Or MB_DEFBUTTON1 Or MB_APPLMODAL)
      Return 1
   End If
   
   If CreateFolder(pPath) = 0 Then
      
      MsgBox(Form1.hWnd ,vfb_LangString("创建文件夹时出错，无法创建文件夹") & vbCrLf & vfb_LangString("可能是以下原因造成的：") & vbCrLf & _
         vfb_LangString("1.磁盘已满，请换个盘安装！") & vbCrLf       & vfb_LangString("2.此盘是光驱，请换个盘安装！") & vbCrLf & vfb_LangString("3.没有此盘，请换个盘安装！") & _
         vbCrLf & vfb_LangString("4.文件夹名称有非法字符，请更名！") & vbCrLf & vfb_LangString("        　　　－－－－请自己检查后更正。") , _
         MB_OK Or MB_ICONERROR Or MB_DEFBUTTON1 Or MB_APPLMODAL)
      Return 1
   End if
   Dim pa As String = FF_FilePath(pExe)
   If UCase(Right(pExe ,4)) = ".FFP" Then
      If ffCopyDir(Form1.hWnd ,pa ,pPath) = 1 Then ' 复制整个文件夹
         Dim cc As String = DirW(pPath & "*.ffp" ,fbNormal Or fbHidden Or fbSystem)
         If Len(cc) Then
            AfxName pPath & cc ,pPath & pFile '修改文件名为新工程名
            pPath &= pFile
            Dim ee As String = GetFileStrW(pPath)
            Dim As Long f1 ,f2
            f1 = InStr(ee ,vbCrLf & "ProjectName=")
            f2 = InStr(f1 + 13 ,ee ,vbCrLf)
            if f1 = 0 Or f2 = 0 Then
               MsgBox(Form1.hWnd ,vfb_LangString("模板有问题，无法创建工程！！！请充装VFB。") ,MB_OK Or MB_ICONERROR Or MB_DEFBUTTON1 Or MB_APPLMODAL)
               Return 1
            End if
            ee = Left(ee ,f1 + 13) & pName & Mid(ee ,f2) '替换工程名
            
            f1 = InStr(ee ,vbCrLf & "LastRunFilename=")
            f2 = InStr(f1 + 17 ,ee ,vbCrLf)
            f2 = InStrRev(ee ,"." ,f2)
            if f1 = 0 Or f2 < f1 Then
               MsgBox(Form1.hWnd ,vfb_LangString("模板有问题，无法创建工程！！！请充装VFB。") ,MB_OK Or MB_ICONERROR Or MB_DEFBUTTON1 Or MB_APPLMODAL)
               Return 1
            End if
            ee = Left(ee ,f1 + 17) & pName & Mid(ee ,f2) '替换编译文件
            
            If SaveFileStr(pPath ,ee) Then
               MsgBox(Form1.hWnd ,vfb_LangString("目标工程无法修改！！！") & vbCrLf & vfb_LangString("请检查目标文件") , _
                  MB_OK Or MB_ICONERROR Or MB_DEFBUTTON1 Or MB_APPLMODAL)
               Return 1
            Else
               OpenGongCen(pPath)
            End If
         Else
            MsgBox(Form1.hWnd ,vfb_LangString("工程模板有错误！！！") & vbCrLf & vfb_LangString("请检查工程模板") , _
               MB_OK Or MB_ICONERROR Or MB_DEFBUTTON1 Or MB_APPLMODAL)
            Return 1
         End If
      End If
   Else
      Dim ee As String = GetFileStrW(pExe)
      Dim ff As Long   = InStr(ee ,vbCrLf)
      ff = InStr(ff + 1 ,ee ,vbCrLf)
      ff = InStr(ff + 1 ,ee ,vbCrLf)
      ff = InStr(ff + 1 ,ee ,vbCrLf) '4次查找，去除头部说明
      If ff > 0 Then ee = Mid(ee ,ff + 2)
      Dim vfbAPP As APP_TYPE Ptr = GetExeAPP()
      Dim tb     As String       = vfb_LangString("'下面内容由 VisualFreeBasic ") & vfbAPP->ProductMajor & "." & vfbAPP->ProductMinor & "." & vfbAPP->ProductRevision & vfb_LangString(" 自动产生，请勿自己修改") & vbCrLf
      tb &= "'[VFB_PROJECT_SETUP_START]" & vbCrLf
      tb &= "'ProjectName="              & pName & vbCrLf
      tb &= "'CompilationMode=0"         & vbCrLf
      tb &= "'CompilationDebug=0"        & vbCrLf
      tb &= "'ShowConsole=0"             & vbCrLf
      tb &= "'MultiLanguage=0"           & vbCrLf
      tb &= "'LastRunFilename="          & pName & ".exe" & vbCrLf
      tb &= "'DeleteGeneratedCode=1"     & vbCrLf
      tb &= "'DefaultCompiler=32"        & vbCrLf
      tb &= "'CharSet=3"                 & vbCrLf
      tb &= "'CodePage="                 & GetACP & vbCrLf
      tb &= "'AddCompOps="               & vbCrLf
      
      Dim pffs As String = Left(pFile ,Len(pFile) -4)
      tb &= "'Module=.\"               & pFile & "|0|0||Yes|" & vbCrLf
      tb &= "'TopTab=.\"               & pFile & "|True|0|0"  & vbCrLf
      tb &= "'[VFB_PROJECT_SETUP_END]" & vbCrLf
      If InStr(ee ,"USING Afx") = 0 Then
         tb &= "{visualfreebasic_lib} 'VFB函数库插入的位置（全部小写，在引用必要的基础库之后），这是让BAS工程支持使用VFB里的源码库和私库文件等，去掉后就无法支持。" & vbCrLf
      Else
         ee = YF_Replace(ee ,"USING Afx" ,"USING Afx" & vbCrLf & "{visualfreebasic_lib} 'VFB函数库插入的位置（全部小写，在引用必要的基础库之后），这是让BAS工程支持使用VFB里的源码库和私库文件等，去掉后就无法支持。")
      End If
      ee = tb & ee
      'pPath &= pName & ".bas"
      If SaveFileStr(pPath & pFile ,ee) Then
         MsgBox(Form1.hWnd ,vfb_LangString("目标工程无法修改！！！") & vbCrLf & vfb_LangString("请检查目标文件") , _
            MB_OK Or MB_ICONERROR Or MB_DEFBUTTON1 Or MB_APPLMODAL)
      Else
         OpenGongCen(pPath & pFile)
      End If
   End If
   Function = 0
End Function

Function PathRelativeToActual(nFile As String ,Pa As String) As String   ' 把相对路径，转换为实际路径
   if Left(nFile ,1) = "#"  Then Return nFile  '# 带头是特殊函数
   If Left(nFile ,2) = ".\" Then Return pa & Mid(nFile ,3)
   If Left(nFile ,6) = "..\..\" Then
      Dim nPa As String = FF_FilePath(Left(Pa ,Len(Pa) -1))
      Return FF_FilePath(Left(nPa ,Len(nPa) -1)) & Mid(nFile ,7)
   End if
   If Left(nFile ,3) = "..\" Then Return FF_FilePath(Left(Pa ,Len(Pa) -1)) & Mid(nFile ,4)
   If InStr(nFile ,":") = 0  Then Return pa                                & Mid(nFile ,3)
   Return nFile
End Function
Function PathActualToRelative(nFile As String ,Pa As String) As String   ' 把实际路径，转换为相对路径
   if Left(nFile ,1) = "#" Then Return nFile  '# 带头是特殊函数
   Dim uPa   As String = UCase(Pa)
   Dim uFile As String = UCase(nFile)
   If Left(uFile ,Len(uPa)) = uPa Then Return ".\" & Mid(nFile ,Len(uPa) + 1)
   uPa = FF_FilePath(Left(uPa ,Len(uPa) -1))
   If Left(uFile ,Len(uPa)) = uPa Then Return "..\" & Mid(nFile ,Len(uPa) + 1)
   uPa = FF_FilePath(Left(uPa ,Len(uPa) -1))
   if Len(uPa) > 0 AndAlso Left(uFile ,Len(uPa)) = uPa Then Return "..\..\" & Mid(nFile ,Len(uPa) + 1)
   
   Return nFile
End Function

Function ffCopyDir(ByVal nHWnd As hWnd ,ByVal souPath As String ,ByVal desPath As String) As Long ' 复制整个文件夹
   'souPath 源文件夹名，最后必须带 \
   'desPath 目标文件夹名，最后必须带 \
   
   Dim As UInteger out_attr ''无符号整数来保存检索的属性
   Dim As String   pp1 ,pp2
   Dim As Long     f   ,u ,i
   
   f = 1
   
   Dim lName() As WIN32_FIND_DATAW
   u = GetDIR(souPath & "*.*" ,lName())
   
   If u Then
      For i = 0 To u -1
         pp1 = souPath & CWSTRtoString(lname(i).cFileName)
         pp2 = desPath & CWSTRtoString(lname(i).cFileName)
         If (lname(i).dwFileAttributes And fbDirectory) <> 0 Then '是文件夹
            If CreateFolder(pp2) = False Then
               f = 0
               MsgBox(nHWnd ,vfb_LangString("创建文件夹时出错，无法创建文件夹") & Chr(13 ,10) & pp2 & Chr(13 ,10) & _
               vfb_LangString("可能是以下原因造成的：") & vbCrLf & vfb_LangString("1.磁盘已满，请换个盘安装！") & vbCrLf & _
               vfb_LangString("2.此盘是光驱，请换个盘安装！") & vbCrLf & vfb_LangString("3.没有此盘，请换个盘安装！") & vbCrLf & vfb_LangString("4.文件夹名称有非法字符，请更名！") _
                  ,MB_OK Or MB_ICONERROR Or MB_DEFBUTTON1 Or MB_APPLMODAL)
            Else
               f = ffCopyDir(nHWnd ,pp1 & "\" ,pp2 & "\")
            End If
         Else
            Do
               f = ffCopyFile(nHWnd ,pp1 ,pp2)
               If f <> 2 Then Exit Do
            Loop
         End If
         If f = 0 Then Exit For
      Next
   End If
   
   Function = f
   
End Function
'--------------------------------------------------------------------------
Function ffCopyFile(nHWnd As hWnd ,pp1 As String ,pp2 As String) As Long '
   
   Dim bb As String ,r As Long
   
   If AfxFileExists(pp2) Then
      
      If AfxIsReadOnlyFile(pp2) Then SetFileAttributesA pp2 & "" ,0
      
   End If
   
   AfxFileCopy pp1 ,pp2
   If Err() Then
      Select Case MsgBox(nHWnd ,vfb_LangString("复制文件时出错！！！") & Chr(13 ,10 ,13 ,10) & vfb_LangString("被复制：") & pp1 & Chr(13 ,10) & vfb_LangString("到目标：") & pp2 & Chr(13 ,10 ,13 ,10) & _
               WinErrorMsg(Err) & Chr(13 ,10 ,13 ,10) & _
               vfb_LangString("可能是以下原因造成的：") & vbCrLf & vfb_LangString("1.有软件在使用中，请关闭！") & vbCrLf & _
               vfb_LangString("2.杀毒软件拦截，请关闭杀毒软件！") & vbCrLf & vfb_LangString("3.权限不够，需要管理身份运行！") & vbCrLf & _
               vfb_LangString("     －－－请自己检查后更正或者联系勇芳远程操作。") ,vfb_LangString("复制文件时出错") , _
               MB_ABORTRETRYIGNORE Or MB_ICONQUESTION Or MB_DEFBUTTON1 Or MB_APPLMODAL)
         Case IDABORT
            Return 0
         Case IDRETRY
            Return 2
         Case IDIGNORE
            Return 1
      End Select
      
   End if
   Function = 1
   
   
End Function

Function NewProControl(pName As String) As Long  '新建工程 ,失败返回非0
   'pName 工程名称  pPath 工程目录  pExe 模板文件  pFile 工程文件
   
   Form2.Show Form1.hWnd, True ,Cast(Integer , @pName )
   Function =  Len(pName) 
End Function

Sub Form1_Text1_EN_Change(hWndForm As hWnd ,hWndControl As hWnd) '文本已经被修改（修改前用 EN_UPDATE
   Dim tt As String = Text1.Text
   Dim vfbAPP As APP_TYPE Ptr = GetExeAPP()   
   If 选择项目 = 2 Then
      If tt = "" Then tt = vfb_LangString("新控件")
      Text2.Text = ".\Control\" & tt & "\"
      Text1.Tag  = ""
      Return
   End if
   If 选择项目 = 3 Then
      If tt = "" Then tt = vfb_LangString("新插件")
      Text2.Text = ".\Plugins\Code\" & tt & "\"
      Text1.Tag  = ""
      Return
   End If
   If 选择项目 = 4 Then
      If tt = "" Then tt = vfb_LangString("新代码")
      Dim hItem  As YFTreeViewData Ptr = YFTreeView1.Selection
      If hItem = 0 Then Return
      Dim aa As Long = hItem->DataValue
      Text2.Text = PathActualToRelative(gcmb(aa) ,vfbAPP->Path) '新工程\"
      Text1.Tag  = ""
      Return
   End If

   Dim OpApp  As pezi Ptr     = GetOpAPP()
   Dim pa     As String       = PathActualToRelative(OpApp->DefaultProjectPath ,vfbAPP->Path) '新工程\"
   Dim jtt    As String       = Text1.Tag
   Dim pp     As String       = Text2.Text
   If pa & jtt & "\" = pp OrElse pa & vfb_LangString("新工程") & "\" = pp Then Text2.Text = pa & tt & "\"
   Text1.Tag = tt
   
End Sub

Sub Form1_Command3_BN_Clicked(hWndForm As hWnd ,hWndControl As hWnd)  '单击
   Dim pp     As CWSTR ,bb As String
   Dim vfbAPP As APP_TYPE Ptr = GetExeAPP()
   bb = PathRelativeToActual(Text2.Text ,vfbapp->Path)
   If Right(bb ,1) <> "\" Then bb &= "\"
   If DirW(bb & "*.*" ,&H37) = "" Then
      Dim OpApp As pezi Ptr = GetOpAPP()
      bb = OpApp->DefaultProjectPath
   End If
   
   pp = FF_BrowseForFolder(hWndForm ,vfb_LangString("选择工程文件夹(工程目录)") ,bb)
   If Len(pp) > 0 Then
      Text2.Text = PathActualToRelative(pp ,vfbapp->Path)
   End If
End Sub

Sub Form1_YFTreeView1_SelChange(hWndForm As hWnd ,hWndControl As hWnd ,newItem As YFTreeViewData Ptr) '列表项目选择已经改变
   'hWndForm    当前窗口的句柄(WIN系统用来识别窗口的一个编号，如果多开本窗口，必须 Me.hWndForm = hWndForm 后才可以执行后续操作本窗口的代码)
   'hWndControl 当前控件的句柄(也是窗口句柄，如果多开本窗口，必须 Me.控件名.hWndForm = hWndForm 后才可以执行后续操作本控件的代码 )
   'newItem    新的项目指针（可以修改成员，修改后需要刷新控件显示，特殊成员由控件处理，只可读，千万别修改）
   '注意：无选择时， newItem=0 ，使用前先判断，不然软件会崩溃，代码修改选择并不会发生本事件。
   If 选择项目 = 4 Then
      Dim hItem As YFTreeViewData Ptr = YFTreeView1.Selection
      Dim vfbAPP As APP_TYPE Ptr = GetExeAPP()
      If hItem Then
         Dim aa As Long = hItem->DataValue
         Text2.Text = PathActualToRelative(gcmb(aa) ,vfbAPP->Path) '新工程\"
         Text1.Tag  = ""
      End If
   End If
   
   
   Text1.SetFocus
End Sub

Sub 加载我的代码库文件夹(ByVal hParent As YFTreeViewData Ptr ,ByVal 目录 As String)
   

   Dim nFile() As WIN32_FIND_DATAW
   If GetDIR(目录  & "*.*" ,nFile()) Then
      Dim i As Long
      For i = 0 To UBound(nFile)
         If (nFile(i).dwFileAttributes And fbDirectory) <> 0 Then
            Dim uu As Long = UBound(gcmb) + 1
            ReDim Preserve gcmb(uu)
            gcmb(uu) = 目录 & CWSTRtoString(nFile(i).cFileName) & "\" 
            Dim mm As YFTreeViewData Ptr = YFTreeView1.AddItem(hParent ,nFile(i).cFileName ,uu,&HE65A,&HF127,1)
            加载我的代码库文件夹(mm ,gcmb(uu))
            
         End If
      Next
   End If

End Sub


















